Giga Games 1/Giga Games.iso/net/usenet/volume4/rubik.shr

Internet Message Format | 1988-05-20 | 27.3 KB

Path: uunet!husc6!bloom-beacon!mit-eddie!uw-beaver!tektronix!tekgen!tekred!games
From: [e-mail]
Newsgroups: comp.sources.games
Subject: v04i014:  rubik - Rubik's Cube Simulator in Pascal for VAX/VMS
Message-ID: <[e-mail]>
Date: 20 May 88 22:31:56 GMT
Sender: [e-mail]
Lines: 910
Approved: [e-mail]

Submitted by: uunet!bsu-cs!starcat (Bud Crittenden)
Comp.sources.games: Volume 4, Issue 14
Archive-name: rubik.shr

    [I haven't tried this, so you're on your own.  -br]

[[Here it is...  It has some open spots for the compiler to chose (such as
the ending, and whether or not the cube is checked for being solved).]]

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#        "End of shell archive."
# Contents:  cube.pas
# Wrapped by billr@saab on Fri May 20 15:02:03 1988
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f cube.pas -a "${1}" != "-c" ; then
  echo shar: Will not over-write existing file \"cube.pas\"
else
echo shar: Extracting \"cube.pas\" \(25565 characters\)
sed "s/^X//" >cube.pas <<'END_OF_cube.pas'
X[INHERIT ('SYS$LIBRARY:STARLET.PEN')]
X(* Rubik's cube simulator for VAX/VMS and ReGIS graphics *)
X(*        by Bud Crittendon             *)
X
XPROGRAM CUBE(INPUT,OUTPUT,OUTFILE);
X
XConst
X  CubeSize = 35;
X  CubeSep =   CubeSize + 6;
X  CubeCornerX = 200;
X  CubeCornerY = 200;
X  TiltAngle = 0.5235987;
X  ColorRed = 1;
X  ColorBlue = 2;
X  ColorYellow = 3;
X
XTYPE
X  Iword       = [WORD] 0..65535;
X  ShortString = PACKED ARRAY [1..12] OF CHAR;
X  Rotate      = (NONE,LEFT,RIGHT,UP,DOWN,FRONT,BACK);
X  Where       = (TILTFRONT,TILTTOP,TILTRIGHT,TILTLEFT,TILTDOWN,TILTBACK);
X  Colors      = (YELLOW,WHITE,BLUE,GREEN,RED,ORANGE);
X  CUBITS = PACKED ARRAY [1..9] OF COLORS;
X  CUBES = PACKED ARRAY [LEFT..BACK] OF CUBITS;
X
XVAR
X  X,
X  Y,
X  L,
X  C1,
X  C2,
X  CUBESEPX,
X  CUBESEPY,
X  CUBEADJX,
X  CUBEADJY,
X  SCORE,
X  MIXES,
X  MOVES,
X  CUBEADJUST,
X  DIR,
X  I:INTEGER;
X  QUIT,
X  DONE:BOOLEAN;
X  CUBEARRAY:CUBES;
X  CCOLOR,
X  COLOR:COLORS;
X  CTYPE,
X  CUBEPLACE:WHERE;
X  TURN:ROTATE;
X  KEY:CHAR;
X  IOCHAN:IWORD;
X  OUTFILE:TEXT;
X
X(******************************************************************************)
X
X[INITIALIZE]
XPROCEDURE InitializeCubeParams;
X  BEGIN
X    WRITELN(CHR(27),'P1p');
X    WRITELN('S(M0(AD)M1(AR)M2(AB)M3(AY))');
X    WRITELN('l(a2)"A"55aa55aa55aa55aa55aa;');
X    WRITELN(CHR(27),'\');
X
X    FOR I := 1 TO 9 DO BEGIN
X      CUBEARRAY[RIGHT][I] := YELLOW;
X      CUBEARRAY[LEFT][I]  := WHITE;
X      CUBEARRAY[UP][I]    := BLUE;
X      CUBEARRAY[DOWN][I]  := GREEN;
X      CUBEARRAY[FRONT][I] := RED;
X      CUBEARRAY[BACK][I]  := ORANGE;
X      END;
X    DONE  := FALSE;
X    QUIT  := FALSE;
X    MOVES := 0;
X    MIXES := 0;
X    SCORE := 0;
X    CubeAdjX := round(CubeSize * cos(TiltAngle));
X    CubeAdjY := round(CubeSize * sin(TiltAngle));
X    CubeSepX := round(CubeSep  * cos(TiltAngle));
X    CubeSepY := round(CubeSep  * sin(TiltAngle));
X  END;
X
X(******************************************************************************)
X
XPROCEDURE Initialize(VAR CUBEARRAY:CUBES;VAR MIXES,MOVES,SCORE:INTEGER);
X
XBEGIN
X    FOR I := 1 TO 9 DO BEGIN
X      CUBEARRAY[RIGHT][I] := YELLOW;
X      CUBEARRAY[LEFT][I]  := WHITE;
X      CUBEARRAY[UP][I]    := BLUE;
X      CUBEARRAY[DOWN][I]  := GREEN;
X      CUBEARRAY[FRONT][I] := RED;
X      CUBEARRAY[BACK][I]  := ORANGE;
X      END;
X    MOVES := 0;
X    MIXES := 0;
X    SCORE := 0;
X  END;
X
X(******************************************************************************)
X
XPROCEDURE REGIS;
X
XBEGIN
X  WRITELN(CHR(27),'Pp');
XEND;
X
X(******************************************************************************)
X
XPROCEDURE ASCII;
X
XBEGIN
X  WRITELN(CHR(27),'[;H');
X  WRITELN(CHR(27),'\');
XEND;
X
X(******************************************************************************)
X
XPROCEDURE POSITION(ROW,COL:INTEGER);
X
XBEGIN
X  WRITELN('P[',COL:1,',',ROW:1,']');
XEND;
X
X(******************************************************************************)
X
XPROCEDURE RANDOMNUMBER(VAR RANDOM:INTEGER;MINVALUE,MAXVALUE:INTEGER);
X
XTYPE
X  STRING = PACKED ARRAY [1..11] OF CHAR;
X
XVAR
X  CURTIME : STRING;
X  SEED : INTEGER;
X
XBEGIN
X  CURTIME := '00:00:00.00';
X  TIME(CURTIME);
X  RANDOM := 0;
X  SEED := 0;
X  SEED := SEED + 1 * (ORD(CURTIME[10])-48);
X  SEED := SEED + 10 * (ORD(CURTIME[11])-48);
X  RANDOM := ROUND((SEED/99) * (MAXVALUE - MINVALUE)) + MINVALUE;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE Coords ( VAR CubeNumber: integer;  VAR CubeType: Where);
X  VAR bx,by,ccx,ccy:integer;
X  BEGIN
X    bx := (CubeNumber-1) MOD 3;
X    by := (CubeNumber-1) DIV 3;
X    CASE CubeType OF
X      TILTFRONT,
X      TILTRIGHT,
X      TILTTOP: BEGIN
X                 ccx := CubeCornerX;
X                 ccy := CubeCornerY;
X               END;
X      TILTBACK: BEGIN
X                  ccx := CubeCornerX + CubeSepX*7;
X                  ccy := CubeCornerY - CubeSepy*7;
X                END;
X      TILTLEFT: BEGIN
X                  ccx := CubeCornerX - CubeSepX*7;
X                  ccy := CubeCornerY;
X                END;
X      TILTDOWN: BEGIN
X                  ccx := CubeCornerX;
X                  ccy := CubeCornerY + CubeSepY*10;
X                END;
X      OTHERWISE;
X      END;
X    CASE CubeType OF
X      TILTFRONT,TILTBACK:
X             BEGIN
X               x := ccx + bx * CubeSep  ;
X               y := ccy + by * CubeSep  ;
X             END;
X      TILTRIGHT,TILTLEFT:
X             BEGIN
X               x := ccx + (CubeSep  * 3) + (bx * CubeSepX);
X               y := ccy + (CubeSep  * by) - (bx * CubeSepY);
X             END;
X      TILTTOP,TILTDOWN:
X             BEGIN
X               x := ccx + (CubeSepX *3) + (bx*CubeSep) - (by*CubeSepX);
X               y := ccy - (CubeSepY *3) + (by*CubeSepY);
X             END;
X      END;
X  END;
X
X(******************************************************************************)
X
XPROCEDURE SetColor(VAR Color: Colors);
X  BEGIN
X    CASE Color OF
X      RED : BEGIN
X              c1 := ColorRed;
X              c2 := ColorRed;
X            END;
X      YELLOW:
X            BEGIN
X              c1 := ColorYellow;
X              c2 := ColorYellow;
X            END;
X      BLUE:
X            BEGIN
X              c1 := ColorBlue;
X              c2 := ColorBlue;
X            END;
X      ORANGE:
X            BEGIN
X              c1 := ColorRed;
X              c2 := ColorYellow;
X            END;
X      WHITE:
X            BEGIN
X              c1 := ColorBlue;
X              c2 := ColorYellow;
X            END;
X      GREEN:
X            BEGIN
X              c1 := ColorBlue;
X              c2 := ColorRed;
X            END;
X      END;
X  END;
X
X(******************************************************************************)
X
XPROCEDURE SetFill(VAR CubeType: Where);
X  VAR solid : boolean;
X  BEGIN
X    solid := (c1 = c2);
X    Write('w(r,i',c1:1,',s');
X    IF solid
X      THEN
X        BEGIN
X          CASE CubeType OF
X            TILTBACK,TILTLEFT,TILTFRONT,TILTRIGHT: Writeln('1)');
X                                 TILTDOWN,TILTTOP: Writeln('1(x))');
X            END;
X        END
X      ELSE
X        BEGIN
X          CASE CubeType OF
X             TILTBACK,TILTLEFT,TILTFRONT,TILTRIGHT: Writeln('"A")s(i',c2:1,')');
X                               TILTDOWN,TILTTOP: Writeln('"A"(x))s(i',c2:1,')');
X             END;
X        END;
X  END;
X
X(******************************************************************************)
X
XPROCEDURE Square (CubeNumber: integer;
X                  CubeType: Where; Color: Colors);
X
X  BEGIN
X    Coords(CubeNumber,CubeType);  (* Compute X,Y *)
X    Writeln('p[',x,',',y,']t(a2)');   (* Place cursor at x,y *)
X    SetColor(Color);             (* Select c1 and c2 *)
X    CASE CubeType OF
X          TILTFRONT,TILTBACK:
X            BEGIN
X              SetFill(CubeType);
X              Writeln('v[,+',cubesize,'][+',cubesize,']');
X            END;
X      TILTRIGHT,TILTLEFT:
X          BEGIN
X             SetFill(CubeType);
X             Writeln('v[,+',cubesize,'][+',CubeAdjX,
X                     ',-',CubeAdjY,']');
X             Writeln('v[,-',cubesize,'][-',CubeAdjX,
X                     ',+',CubeAdjY,']')
X          END;
X        TILTTOP,TILTDOWN:
X          BEGIN
X             SetFill(CubeType);
X             Writeln('v[-',CubeAdjX,',+',CubeAdjY,
X                     '][+',Cubesize,']');
X             Writeln('v[+',CubeAdjX,',-',CubeadjY,']');
X           END;
X    END;
X  Writeln('w(s0)s(i0)t(a0)');
X END;
X
X(******************************************************************************)
X
XPROCEDURE OPENKEY;
X  VAR
X    STAT : IWORD;
X    DEVNAME: SHORTSTRING;
X  BEGIN
X    DEVNAME := 'TT:';
X    STAT := $ASSIGN(DEVNAME,IOCHAN);
X  END;
X
X(******************************************************************************)
X
XPROCEDURE SHUTKEY;
X  VAR
X    STAT : IWORD;
X  BEGIN
X    STAT := $DASSGN(IOCHAN);
X  END;
X
X(******************************************************************************)
X
XFUNCTION GETKEY:CHAR;
X  VAR
X    FUNC,STAT : IWORD;
X    CH : CHAR;
X  BEGIN
X    FUNC := IO$_READVBLK + IO$M_NOECHO + IO$M_NOFILTR;
X    STAT := $QIOW (,IOCHAN,FUNC,,,,CH,1);
X    GETKEY := CH;
X  END;
X
X(******************************************************************************)
X
XPROCEDURE SIDES(TURN:ROTATE);
X
XBEGIN
X  CASE TURN OF
X    FRONT : FOR I := 1 TO 3 DO BEGIN
X              SQUARE(I,TILTFRONT,CUBEARRAY[FRONT][I]);
X              SQUARE(I+3,TILTFRONT,CUBEARRAY[FRONT][I+3]);
X              SQUARE(I+6,TILTFRONT,CUBEARRAY[FRONT][I+6]);
X              SQUARE((I+6),TILTTOP,CUBEARRAY[UP][I+6]);
X              SQUARE(((I*3)-2),TILTRIGHT,CUBEARRAY[RIGHT][((I*3)-2)]);
X              SQUARE((I+6),TILTDOWN,CUBEARRAY[DOWN][I]);
X              SQUARE(((I*3)-2),TILTLEFT,CUBEARRAY[LEFT][(I*3)]);
X              END;
X    RIGHT : FOR I := 1 TO 3 DO BEGIN
X              SQUARE(I,TILTRIGHT,CUBEARRAY[RIGHT][I]);
X              SQUARE(I+3,TILTRIGHT,CUBEARRAY[RIGHT][I+3]);
X              SQUARE(I+6,TILTRIGHT,CUBEARRAY[RIGHT][I+6]);
X              SQUARE((I*3),TILTTOP,CUBEARRAY[UP][I*3]);
X              SQUARE((I*3),TILTFRONT,CUBEARRAY[FRONT][(I*3)]);
X              SQUARE((I*3),TILTDOWN,CUBEARRAY[DOWN][((4-I)*3)]);
X              SQUARE((I*3),TILTBACK,CUBEARRAY[BACK][((I*3)-2)]);
X              END;
X    UP    : FOR I := 1 TO 3 DO BEGIN
X              SQUARE(I,TILTTOP,CUBEARRAY[UP][I]);
X              SQUARE(I+3,TILTTOP,CUBEARRAY[UP][I+3]);
X              SQUARE(I+6,TILTTOP,CUBEARRAY[UP][I+6]);
X              SQUARE(I,TILTFRONT,CUBEARRAY[FRONT][I]);
X              SQUARE(I,TILTRIGHT,CUBEARRAY[RIGHT][I]);
X              SQUARE(I,TILTLEFT,CUBEARRAY[LEFT][(4-I)]);
X              SQUARE(I,TILTBACK,CUBEARRAY[BACK][(4-I)]);
X              END;
X    BACK  : FOR I := 1 TO 3 DO BEGIN
X              SQUARE(I,TILTBACK,CUBEARRAY[BACK][(4-I)]);
X              SQUARE(I+3,TILTBACK,CUBEARRAY[BACK][(4-I)+3]);
X              SQUARE(I+6,TILTBACK,CUBEARRAY[BACK][(4-I)+6]);
X              SQUARE(I,TILTTOP,CUBEARRAY[UP][I]);
X              SQUARE((I*3),TILTRIGHT,CUBEARRAY[RIGHT][(I*3)]);
X              SQUARE((I*3),TILTLEFT,CUBEARRAY[LEFT][((I*3)-2)]);
X              SQUARE(I,TILTDOWN,CUBEARRAY[DOWN][(I+6)]);
X              END;
X    LEFT  : FOR I := 1 TO 3 DO BEGIN
X              SQUARE(I,TILTLEFT,CUBEARRAY[LEFT][(4-I)]);
X              SQUARE(I+3,TILTLEFT,CUBEARRAY[LEFT][(4-I)+3]);
X              SQUARE(I+6,TILTLEFT,CUBEARRAY[LEFT][(4-I)+6]);
X              SQUARE(((I*3)-2),TILTTOP,CUBEARRAY[UP][((I*3)-2)]);
X              SQUARE(((I*3)-2),TILTFRONT,CUBEARRAY[FRONT][((I*3)-2)]);
X              SQUARE(((I*3)-2),TILTBACK,CUBEARRAY[BACK][(I*3)]);
X              SQUARE(((I*3)-2),TILTDOWN,CUBEARRAY[DOWN][(((4-I)*3)-2)]);
X              END;
X    DOWN  : FOR I := 1 TO 3 DO BEGIN
X              SQUARE(I+6,TILTDOWN,CUBEARRAY[DOWN][I]);
X              SQUARE(I+3,TILTDOWN,CUBEARRAY[DOWN][I+3]);
X              SQUARE(I,TILTDOWN,CUBEARRAY[DOWN][(I+6)]);
X              SQUARE((I+6),TILTFRONT,CUBEARRAY[FRONT][(I+6)]);
X              SQUARE((I+6),TILTRIGHT,CUBEARRAY[RIGHT][(I+6)]);
X              SQUARE((I+6),TILTBACK,CUBEARRAY[BACK][((4-I)+6)]);
X              SQUARE((I+6),TILTLEFT,CUBEARRAY[LEFT][((4-I)+6)]);
X              END;
X    END;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE TURNSIDE(TURN:ROTATE;DIR:INTEGER);
X
XVAR
X  NUMBER:INTEGER;
X  TEMP:COLORS;
X
XBEGIN
X  FOR NUMBER := 1 TO DIR DO BEGIN
X    TEMP               := CUBEARRAY[TURN][1];
X    CUBEARRAY[TURN][1] := CUBEARRAY[TURN][7];
X    CUBEARRAY[TURN][7] := CUBEARRAY[TURN][9];
X    CUBEARRAY[TURN][9] := CUBEARRAY[TURN][3];
X    CUBEARRAY[TURN][3] := TEMP;
X    TEMP               := CUBEARRAY[TURN][2];
X    CUBEARRAY[TURN][2] := CUBEARRAY[TURN][4];
X    CUBEARRAY[TURN][4] := CUBEARRAY[TURN][8];
X    CUBEARRAY[TURN][8] := CUBEARRAY[TURN][6];
X    CUBEARRAY[TURN][6] := TEMP;
X    END;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE CHANGEARRAY(VAR CUBEARRAY:CUBES;TURN:ROTATE;DIR:INTEGER);
X
XVAR
X  TEMPARRAY : PACKED ARRAY [1..3] OF COLORS;
X  TEMP:COLORS;
X  J,
X  X,
X  Y:INTEGER;
X
XBEGIN
X  TURNSIDE(TURN,DIR);
X  FOR X := 1 TO DIR DO BEGIN
X    IF (TURN = UP) THEN
X      FOR J := 1 TO 3 DO BEGIN
X        TEMP                := CUBEARRAY[FRONT][J];
X        CUBEARRAY[FRONT][J] := CUBEARRAY[RIGHT][J];
X        CUBEARRAY[RIGHT][J] := CUBEARRAY[BACK][J];
X        CUBEARRAY[BACK][J]  := CUBEARRAY[LEFT][J];
X        CUBEARRAY[LEFT][J]  := TEMP;
X        END;
X    IF (TURN = DOWN) THEN
X      FOR J := 1 TO 3 DO BEGIN
X        TEMP                  := CUBEARRAY[FRONT][J+6];
X        CUBEARRAY[FRONT][J+6] := CUBEARRAY[LEFT][J+6];
X        CUBEARRAY[LEFT][J+6]  := CUBEARRAY[BACK][J+6];
X        CUBEARRAY[BACK][J+6]  := CUBEARRAY[RIGHT][J+6];
X        CUBEARRAY[RIGHT][J+6] := TEMP;
X        END;
X    IF (TURN = RIGHT) THEN
X      FOR J := 1 TO 3 DO BEGIN
X        TEMP                      := CUBEARRAY[FRONT][(4-J)*3];
X        CUBEARRAY[FRONT][(4-J)*3] := CUBEARRAY[DOWN][(4-J)*3];
X        CUBEARRAY[DOWN][(4-J)*3]  := CUBEARRAY[BACK][(J*3)-2];
X        CUBEARRAY[BACK][(J*3)-2]  := CUBEARRAY[UP][(4-J)*3];
X        CUBEARRAY[UP][(4-J)*3]    := TEMP;
X        END;
X    IF (TURN = LEFT) THEN
X      FOR J := 1 TO 3 DO BEGIN
X        TEMP                       := CUBEARRAY[FRONT][(J*3)-2];
X        CUBEARRAY[FRONT][(J*3)-2]  := CUBEARRAY[UP][(J*3)-2];
X        CUBEARRAY[UP][(J*3)-2]     := CUBEARRAY[BACK][(4-J)*3];
X        CUBEARRAY[BACK][(4-J)*3]   := CUBEARRAY[DOWN][(J*3)-2];
X        CUBEARRAY[DOWN][(J*3)-2]   := TEMP;
X        END;
X    IF (TURN = FRONT) THEN
X      FOR J := 1 TO 3 DO BEGIN
X        TEMP                       := CUBEARRAY[UP][J+6];
X        CUBEARRAY[UP][J+6]         := CUBEARRAY[LEFT][(4-J)*3];
X        CUBEARRAY[LEFT][(4-J)*3]   := CUBEARRAY[DOWN][(4-J)];
X        CUBEARRAY[DOWN][(4-J)]     := CUBEARRAY[RIGHT][(J*3)-2];
X        CUBEARRAY[RIGHT][(J*3)-2]  := TEMP
X        END;
X    IF (TURN = BACK) THEN
X      FOR J := 1 TO 3 DO BEGIN
X        TEMP                      := CUBEARRAY[UP][4-J];
X        CUBEARRAY[UP][4-J]        := CUBEARRAY[RIGHT][(4-J)*3];
X        CUBEARRAY[RIGHT][(4-J)*3] := CUBEARRAY[DOWN][J+6];
X        CUBEARRAY[DOWN][J+6]      := CUBEARRAY[LEFT][(J*3)-2];
X        CUBEARRAY[LEFT][(J*3)-2]  := TEMP
X        END;
X    END;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE DRAWCUBE;
X
XVAR
X  I : INTEGER;
X
XBEGIN
X  FOR I := 1 TO 3 DO BEGIN
X    SQUARE(I,TILTTOP,CUBEARRAY[UP][I]);
X    SQUARE(I+3,TILTTOP,CUBEARRAY[UP][I+3]);
X    SQUARE(I+6,TILTTOP,CUBEARRAY[UP][I+6]);
X    SQUARE(I,TILTFRONT,CUBEARRAY[FRONT][I]);
X    SQUARE(I+3,TILTFRONT,CUBEARRAY[FRONT][I+3]);
X    SQUARE(I+6,TILTFRONT,CUBEARRAY[FRONT][I+6]);
X    SQUARE(I,TILTRIGHT,CUBEARRAY[RIGHT][I]);
X    SQUARE(I+3,TILTRIGHT,CUBEARRAY[RIGHT][I+3]);
X    SQUARE(I+6,TILTRIGHT,CUBEARRAY[RIGHT][I+6]);
X    SQUARE(I,TILTBACK,CUBEARRAY[BACK][(4-I)]);
X    SQUARE(I+3,TILTBACK,CUBEARRAY[BACK][(4-I)+3]);
X    SQUARE(I+6,TILTBACK,CUBEARRAY[BACK][(4-I)+6]);
X    SQUARE(I,TILTLEFT,CUBEARRAY[LEFT][(4-I)]);
X    SQUARE(I+3,TILTLEFT,CUBEARRAY[LEFT][(4-I)+3]);
X    SQUARE(I+6,TILTLEFT,CUBEARRAY[LEFT][(4-I)+6]);
X    SQUARE(I,TILTDOWN,CUBEARRAY[DOWN][I+6]);
X    SQUARE(I+3,TILTDOWN,CUBEARRAY[DOWN][I+3]);
X    SQUARE(I+6,TILTDOWN,CUBEARRAY[DOWN][I]);
X    END;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE TURNCUBE(VAR CUBEARRAY:CUBES;TURN:ROTATE);
X
XVAR
X  TEMPARRAY : PACKED ARRAY [1..9] OF COLORS;
X  J:INTEGER;
X
XBEGIN
X  CASE TURN OF
X    UP    : BEGIN
X              TURNSIDE(RIGHT,1);
X              TURNSIDE(LEFT,3);
X              FOR J := 1 TO 9 DO BEGIN
X                TEMPARRAY[J]          := CUBEARRAY[UP][J];
X                CUBEARRAY[UP][J]      := CUBEARRAY[FRONT][J];
X                CUBEARRAY[FRONT][J]   := CUBEARRAY[DOWN][J];
X                CUBEARRAY[DOWN][J]    := CUBEARRAY[BACK][10-J];
X                CUBEARRAY[BACK][10-J] := TEMPARRAY[J];
X                END;
X              END;
X    DOWN  : BEGIN
X              TURNSIDE(RIGHT,3);
X              TURNSIDE(LEFT,1);
X              FOR J := 1 TO 9 DO BEGIN
X                TEMPARRAY[J]          := CUBEARRAY[UP][J];
X                CUBEARRAY[UP][J]      := CUBEARRAY[BACK][10-J];
X                CUBEARRAY[BACK][10-J] := CUBEARRAY[DOWN][J];
X                CUBEARRAY[DOWN][J]    := CUBEARRAY[FRONT][J];
X                CUBEARRAY[FRONT][J]   := TEMPARRAY[J];
X                END;
X              END;
X    RIGHT : BEGIN
X              TURNSIDE(UP,3);
X              TURNSIDE(DOWN,1);
X              FOR J := 1 TO 9 DO BEGIN
X                TEMPARRAY[J]          := CUBEARRAY[FRONT][J];
X                CUBEARRAY[FRONT][J]   := CUBEARRAY[LEFT][J];
X                CUBEARRAY[LEFT][J]    := CUBEARRAY[BACK][J];
X                CUBEARRAY[BACK][J]    := CUBEARRAY[RIGHT][J];
X                CUBEARRAY[RIGHT][J]   := TEMPARRAY[J];
X                END;
X              END;
X    LEFT  : BEGIN
X              TURNSIDE(UP,1);
X              TURNSIDE(DOWN,3);
X              FOR J := 1 TO 9 DO BEGIN
X                TEMPARRAY[J]          := CUBEARRAY[FRONT][J];
X                CUBEARRAY[FRONT][J]   := CUBEARRAY[RIGHT][J];
X                CUBEARRAY[RIGHT][J]   := CUBEARRAY[BACK][J];
X                CUBEARRAY[BACK][J]    := CUBEARRAY[LEFT][J];
X                CUBEARRAY[LEFT][J]    := TEMPARRAY[J];
X                END;
X              END;
X    END;
X  DRAWCUBE;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE LOADCUBE(VAR CUBEARRAY:CUBES;VAR MOVES,MIXES:INTEGER);
X
XBEGIN
X  OPEN (FILE_NAME     := 'SYS$LOGIN:CUBE.DAT',
X        FILE_VARIABLE := OUTFILE,
X        HISTORY       := OLD,
X        ACCESS_METHOD := SEQUENTIAL);
X  RESET(OUTFILE);
X  FOR I := 1 TO 9 DO BEGIN
X    READLN(OUTFILE,CUBEARRAY[RIGHT][I]);
X    READLN(OUTFILE,CUBEARRAY[LEFT][I]);
X    READLN(OUTFILE,CUBEARRAY[UP][I]);
X    READLN(OUTFILE,CUBEARRAY[DOWN][I]);
X    READLN(OUTFILE,CUBEARRAY[FRONT][I]);
X    READLN(OUTFILE,CUBEARRAY[BACK][I]);
X    END;
X    READLN(OUTFILE,MOVES,MIXES);
X  CLOSE(OUTFILE);
XEND;
X
X(******************************************************************************)
X
XPROCEDURE SAVECUBE;
X
XBEGIN
X  OPEN (FILE_NAME     := 'SYS$LOGIN:CUBE.DAT',
X        FILE_VARIABLE := OUTFILE,
X        HISTORY       := NEW,
X        ACCESS_METHOD := SEQUENTIAL);
X  REWRITE(OUTFILE);
X  FOR I := 1 TO 9 DO BEGIN
X    WRITELN(OUTFILE,CUBEARRAY[RIGHT][I]);
X    WRITELN(OUTFILE,CUBEARRAY[LEFT][I]);
X    WRITELN(OUTFILE,CUBEARRAY[UP][I]);
X    WRITELN(OUTFILE,CUBEARRAY[DOWN][I]);
X    WRITELN(OUTFILE,CUBEARRAY[FRONT][I]);
X    WRITELN(OUTFILE,CUBEARRAY[BACK][I]);
X    END;
X   WRITELN(OUTFILE,MOVES,MIXES);
X   CLOSE(OUTFILE);
XEND;
X
X(******************************************************************************)
X
XPROCEDURE WRITEMOVES(MOVES:INTEGER);
X
XBEGIN
X  POSITION(50,50);
X  WRITELN('T''Moves : ',MOVES:1,' '' ');
XEND;
X
X(******************************************************************************)
X
XPROCEDURE WRITEMIXES(MIXES:INTEGER);
X
XBEGIN
X  POSITION(70,50);
X  WRITELN('T''Mixes : ',MIXES:1,' '' ');
XEND;
X
X(******************************************************************************)
X
XPROCEDURE DRAWSCREEN;
X
XBEGIN
X  REGIS;
X  Writeln('s(m0(ad)m1(ar)m2(ab)m3(ay))');
X  WRITELN('S(C0)');
X  WRITELN('S(E)');
X  POSITION(50,600);
X  WRITELN('T''Side to move : '' ');
X  POSITION(70,620);
X  WRITELN('T''U = Up'' ');
X  POSITION(90,620);
X  WRITELN('T''D = Down'' ');
X  POSITION(110,620);
X  WRITELN('T''R = Right'' ');
X  POSITION(130,620);
X  WRITELN('T''L = Left'' ');
X  POSITION(150,620);
X  WRITELN('T''F = Front'' ');
X  POSITION(170,620);
X  WRITELN('T''B = Back'' ');
X  POSITION(200,600);
X  WRITELN('T''Direction : '' ');
X  POSITION(220,620);
X  WRITELN('T''+ = +  90 Degrees'' ');
X  POSITION(240,620);
X  WRITELN('T''- = -  90 Degrees'' ');
X  POSITION(260,620);
X  WRITELN('T''2 =   180 Degrees'' ');
X  POSITION(290,600);
X  WRITELN('T''Other Commands : '' ');
X  POSITION(310,620);
X  WRITELN('T''CTRL-F = Fix Cube'' ');
X  POSITION(330,620);
X  WRITELN('T''CTRL-J = Jumble Cube'' ');
X  POSITION(350,620);
X  WRITELN('T''CTRL-L = Load Game'' ');
X  POSITION(370,620);
X  WRITELN('T''CTRL-H = Save Game'' ');
X  POSITION(390,620);
X  WRITELN('T''CTRL-W = Screen Refresh'' ');
X  POSITION(410,620);
X  WRITELN('T''CTRL-Z = Quit Game'' ');
X  POSITION(430,620);
X  WRITELN('T''Arrow Keys = Rotate'' ');
X  WRITEMIXES(MIXES);
X  WRITEMOVES(MOVES);
X  DRAWCUBE;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE CHECKCUBE(VAR DONE:BOOLEAN);
X
XVAR
X  I:INTEGER;
X
XBEGIN
X  DONE := TRUE;
X  FOR I := 1 TO 9 DO BEGIN
X    IF (CUBEARRAY[UP][I]    <> CUBEARRAY[UP][5])    THEN DONE := FALSE;
X    IF (CUBEARRAY[DOWN][I]  <> CUBEARRAY[DOWN][5])  THEN DONE := FALSE;
X    IF (CUBEARRAY[RIGHT][I] <> CUBEARRAY[RIGHT][5]) THEN DONE := FALSE;
X    IF (CUBEARRAY[LEFT][I]  <> CUBEARRAY[LEFT][5])  THEN DONE := FALSE;
X    IF (CUBEARRAY[FRONT][I] <> CUBEARRAY[FRONT][5]) THEN DONE := FALSE;
X    IF (CUBEARRAY[BACK][I]  <> CUBEARRAY[BACK][5])  THEN DONE := FALSE;
X    END;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE ESCAPE(VAR KEY:CHAR);
X
XVAR
X  KEY2,
X  KEY3:CHAR;
X
XBEGIN
X  KEY2 := ' ';
X  KEY3 := ' ';
X  KEY2 := GETKEY;
X  IF (KEY2 = CHR(63)) OR (KEY2 = CHR(79)) THEN
X    BEGIN
X      KEY3 := GETKEY;
X      CASE KEY3 OF
X        CHR(108) : KEY := ',';
X        CHR(109) : KEY := '-';
X        CHR(112) : KEY := '0';
X        CHR(113) : KEY := '1';
X        CHR(114) : KEY := '2';
X        CHR(115) : KEY := '3';
X        CHR(116) : KEY := '4';
X        CHR(117) : KEY := '5';
X        CHR(118) : KEY := '6';
X        CHR(119) : KEY := '7';
X        CHR(120) : KEY := '8';
X        CHR(121) : KEY := '9';
X        END;
X      END;
X    IF (KEY2 = CHR(91)) THEN BEGIN
X      KEY3 := GETKEY;
X      CASE KEY3 OF
X        CHR(65) : TURNCUBE(CUBEARRAY,UP);
X        CHR(66) : TURNCUBE(CUBEARRAY,DOWN);
X        CHR(67) : TURNCUBE(CUBEARRAY,RIGHT);
X        CHR(68) : TURNCUBE(CUBEARRAY,LEFT);
X        END;
X      END;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE MESSCUBE(VAR CUBEARRAY:CUBES);
X
XVAR
X  DONE:BOOLEAN;
X  TEMP,
X  RANDOM2,
X  RANDOM3:INTEGER;
X  RANDOMTURN:ROTATE;
X
XBEGIN
X  FOR I := 1 TO 40 DO BEGIN
X    DONE := FALSE;
X    REPEAT
X      RANDOMNUMBER(RANDOM2,1,6);
X      CASE RANDOM2 OF
X        1 : BEGIN
X              IF (RANDOM2 <> TEMP) AND (TEMP <> 2) THEN
X                RANDOMTURN := FRONT;
X              DONE := TRUE;
X              END;
X        2 : BEGIN
X              IF (RANDOM2 <> TEMP) AND (TEMP <> 1) THEN
X                RANDOMTURN := BACK;
X              DONE := TRUE;
X              END;
X        3 : BEGIN
X              IF (RANDOM2 <> TEMP) AND (TEMP <> 4) THEN
X                RANDOMTURN := LEFT;
X              DONE := TRUE;
X              END;
X        4 : BEGIN
X              IF (RANDOM2 <> TEMP) AND (TEMP <> 3) THEN
X                RANDOMTURN := RIGHT;
X              DONE := TRUE;
X              END;
X        5 : BEGIN
X              IF (RANDOM2 <> TEMP) AND (TEMP <> 6) THEN
X                RANDOMTURN := UP;
X              DONE := TRUE;
X              END;
X        6 : BEGIN
X              IF (RANDOM2 <> TEMP) AND (TEMP <> 5) THEN
X                RANDOMTURN := DOWN;
X              DONE := TRUE;
X              END;
X        END
X      UNTIL DONE;
X    RANDOMNUMBER(RANDOM3,1,2);
X    IF RANDOM3 = 2 THEN
X      RANDOM3 := 3;
X    CHANGEARRAY(CUBEARRAY,RANDOMTURN,RANDOM3);
X    TEMP := RANDOM2;
X    END;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE TYPED(VAR TURN:ROTATE;VAR DIR:INTEGER;VAR DONE:BOOLEAN;VAR
X                MOVES:INTEGER);
X
XBEGIN
X  TURN := NONE;
X  REPEAT
X    KEY := GETKEY;
X    IF (KEY = CHR(27)) THEN ESCAPE(KEY);
X    CASE KEY OF
X      CHR(6)       : BEGIN
X                       TURN := NONE;
X                       INITIALIZE(CUBEARRAY,MIXES,MOVES,SCORE);
X                       DRAWCUBE;
X                       END;
X      CHR(10)      : BEGIN
X                      MESSCUBE(CUBEARRAY);
X                      MESSCUBE(CUBEARRAY);
X                      MIXES := MIXES +1;
X                      DRAWCUBE;
X                      WRITEMIXES(MIXES);
X                      TURN := NONE;
X                      END;
X      CHR(8)      : BEGIN
X                      SAVECUBE;
X                      END;
X      CHR(12)     : BEGIN
X                      LOADCUBE(CUBEARRAY,MOVES,MIXES);
X                      DRAWCUBE;
X                      WRITEMOVES(MOVES);
X                      WRITEMIXES(MIXES);
X                      TURN := NONE;
X                      END;
X      CHR(26)     : DONE := TRUE;
X      CHR(23)     : DRAWSCREEN;
X      'R','r','6' : TURN := RIGHT;
X      'L','l','4' : TURN := LEFT;
X      'F','f','5' : TURN := FRONT;
X      'B','b','9' : TURN := BACK;
X      'U','u','8' : TURN := UP;
X      'D','d','2' : TURN := DOWN
X    OTHERWISE
X      TURN := NONE;
X      END;
X  UNTIL (TURN <> NONE) OR (KEY = CHR(23)) OR (KEY = CHR(26)) OR
X        (KEY = CHR(8)) OR (KEY = CHR(12));
X  DIR := 0;
X  IF (KEY <> CHR(23)) AND (KEY <> CHR(26))  AND
X     (KEY <> CHR(8)) AND (KEY <> CHR(12)) THEN REPEAT
X    KEY := GETKEY;
X    IF (KEY = CHR(27)) THEN ESCAPE(KEY);
X    CASE KEY OF
X      '+',',' : DIR := 1;
X      '2'     : DIR := 2;
X      '-'     : DIR := 3
X    OTHERWISE
X      DIR := 0;
X      END
X    UNTIL (DIR <> 0);
X  IF (DIR <> 0) THEN MOVES := MOVES + 1;
XEND;
X
X(******************************************************************************)
X
X(* MAIN *)
X
XBEGIN
X  OPENKEY;
X  KEY   := ' ';
X  I := 0;
X    REGIS;
X    WRITELN('T(A0)');
X    DRAWSCREEN;
X    QUIT := FALSE;
X    WHILE NOT(DONE) AND NOT(QUIT) DO BEGIN
X      I := 0;
X      TYPED(TURN,DIR,QUIT,MOVES);
X      CHANGEARRAY(CUBEARRAY,TURN,DIR);
X      SIDES(TURN);
X      WRITEMOVES(MOVES);
X  (*    CHECKCUBE(DONE);*)
X      END;
X  IF DONE THEN BEGIN
X    END;
X  SHUTKEY;
X  ASCII;
XEND.
END_OF_cube.pas
if test 25565 -ne `wc -c <cube.pas`; then
    echo shar: \"cube.pas\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of shell archive.
exit 0